home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / resize1a / drawrain.frm next >
Text File  |  1999-09-10  |  4KB  |  145 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   1620
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   4590
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   108
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   306
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.PictureBox Picture1 
  14.       AutoRedraw      =   -1  'True
  15.       Height          =   1575
  16.       Left            =   0
  17.       ScaleHeight     =   101
  18.       ScaleMode       =   3  'Pixel
  19.       ScaleWidth      =   301
  20.       TabIndex        =   0
  21.       Top             =   0
  22.       Width           =   4575
  23.       Begin VB.Shape Shape1 
  24.          BorderColor     =   &H007F7F7F&
  25.          BorderWidth     =   4
  26.          Height          =   855
  27.          Left            =   720
  28.          Top             =   240
  29.          Width           =   1095
  30.       End
  31.    End
  32. End
  33. Attribute VB_Name = "Form1"
  34. Attribute VB_GlobalNameSpace = False
  35. Attribute VB_Creatable = False
  36. Attribute VB_PredeclaredId = True
  37. Attribute VB_Exposed = False
  38. 'DrawRainBow ⌐ oigres P
  39. 'Email: oigres@postmaster.co.uk
  40. 'indented by indenter5 from www.BMSLtd.co.uk
  41. Dim PreviousWidth As Long, PreviousHeight As Long
  42. Dim pnt As Boolean
  43.  
  44.  
  45. 'draw rainbow pure colours = no grey, third colour
  46. Private Sub Form_Load()
  47.     Show
  48.     'resize executed on startup so no need
  49.     'drawrainbow
  50.  
  51. End Sub
  52.  
  53. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  54.     Static pre1 As Long
  55.     Static pre2 As Long
  56.     Static prex
  57.     Static prey
  58.     With Shape1
  59.         .Visible = False
  60.         .Top = 0 'Picture1.Top
  61.         .Left = x - 4
  62.         .Width = 8
  63.         .Height = Picture1.Height
  64.         .Visible = True
  65.     End With
  66.  
  67.  
  68.     r = &HFF& And Picture1.Point(x, y)
  69.     g = ShiftRight((&HFF00& And Picture1.Point(x, y)), 8)
  70.     b = ShiftRight((&HFF0000 And Picture1.Point(x, y)), 16)
  71.     Form1.Caption = "R=" & Format(Hex(r), "00") & ":G=" & Format(Hex(g), "00") & ":B=" & Format(Hex(b), "00") '& "-:-Formwidth= " & Form1.ScaleWidth
  72.     Picture1.ToolTipText = Form1.Caption
  73.     Form1.Caption = Form1.Caption & " - Resizeable Spectrum By oigres P"
  74.  
  75.  
  76. End Sub
  77. Private Function ShiftRight(x As Long, y As Long) As Long
  78. 'funct from Derek Haas
  79. 'kibblesnbits@ snip.net
  80.     ShiftRight = x \ 2 ^ y 'This shifts them
  81. End Function
  82.  
  83. Private Sub drawrainbow()
  84.     'based on an idea I got from a part of a complicated vb prog called FireStarter
  85.     'firestarter 1999 by Nonlinear Solutions - nls@inode.at
  86.     ''''Visit them at WWW.INODE.AT/NLS
  87.     '
  88.     ' algorithm : split form into 6 bits
  89.     '
  90.     'Dim section  As Integer
  91.     r = 255: g = 0: b = 0
  92.     'radd = 0: gadd = 0: badd = 0
  93.     cadd = 3
  94.     frmscw = Form1.ScaleWidth ' same as picture1.width
  95.     frm2 = Int((frmscw \ 6)) 'integer div; 1 6th of form1.scalewidth  '(frmscw / 1535) * 6
  96.     cadd = 255 / frm2: cadd2 = 0 'cadd; colour addon ; note:255 not 256
  97.    'section = Int(((frmscw - 1) / 6))
  98.     FrmSh = Form1.ScaleHeight - 1
  99.     For x = 0 To frm2 ' section '1 6th of form size
  100.         cadd3 = Int(cadd2) ' cut off fraction for byte
  101.         clr1 = RGB(255, cadd3, 0) 'red to yellow
  102.         Picture1.Line (x, 0)-(x, FrmSh), clr1
  103.  
  104.         clr2 = RGB(255 - cadd3, 255, 0) 'yellow to green
  105.         Picture1.Line (x + (frm2), 0)-(x + (frm2), FrmSh), clr2
  106.  
  107.         clr3 = RGB(0, 255, cadd3) 'green to cyan
  108.         Picture1.Line (x + (frm2 * 2), 0)-(x + (frm2 * 2), FrmSh), clr3
  109.  
  110.         clr4 = RGB(0, 255 - cadd3, 255) 'cyan to blue
  111.         Picture1.Line (x + (frm2 * 3), 0)-(x + (frm2 * 3), FrmSh), clr4
  112.  
  113.         clr5 = RGB(cadd3, 0, 255) 'blue to magenta
  114.         Picture1.Line (x + (frm2 * 4), 0)-(x + (frm2 * 4), FrmSh), clr5
  115.  
  116.         clr6 = RGB(255, 0, 255 - cadd3) 'magenta to red
  117.         Picture1.Line (x + (frm2 * 5), 0)-(x + (frm2 * 5), FrmSh), clr6
  118.  
  119.         cadd2 = cadd2 + cadd 'accumulate
  120.  
  121.     Next x ' each point in section
  122.  
  123. End Sub
  124.  
  125.  
  126. Private Sub Form_Resize()
  127.     With Picture1
  128.         .Visible = False
  129.         .Top = 0: Picture1.Left = 0
  130.         .Width = ScaleWidth: Picture1.Height = ScaleHeight
  131.         .Visible = True
  132.     End With
  133.  
  134.     drawrainbow
  135.     With Shape1
  136.         .Visible = False
  137.         .Top = 0 'Picture1.Top
  138.         'Shape1.Left = x - 4
  139.         .Width = 8
  140.         .Height = Picture1.Height
  141.         .Visible = True
  142.     End With
  143.  
  144. End Sub
  145.